Celestin Apprentice 7/Apprentice-Release7.iso/Demos/Component Software/FileFlex 2.0.3.sit/FileFlex 2.0.3/FileFlex-Director/FileFlex Xtras/-Validation Suite/00003_performTests 2.ls

Text File | 1996-07-21 | 8.9 KB | 311 lines

on tDBSeek
  tTest("DBSeek")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:VIDNAME"
  else
    set theDBFile to the moviePath & "TESTDATA\VIDNAME"
  end if
  set indexID to DBUseIndex(theDBFile)
  if indexID < 0 then
    tmsg("==== DBUse returned" && indexID)
    tFail()
  else
    set DBResult to DBTop()
    if DBResult < 0 then
      tmsg("==== DBTop returned" && DBResult)
      tFail()
    else
      set searcher to padIt("TOPPER", 30, " ")
      set seekResult to DBSeek(searcher)
      if seekResult < 0 then
        tmsg("==== DBSeek returned" && seekResult)
        tFail()
      else
        set theRec to DBCurrRecNum()
        if theRec <> 12 then
          tmsg("==== DBCurrRecNum returned" && theRec)
          tFail()
        else
          set DBResult to DBCloseIndex(indexID)
          if DBResult < 0 then
            tmsg("==== DBCloseIndex returned" && DBResult)
            tFail()
          else
            tPass()
          end if
        end if
      end if
    end if
  end if
end

on tDBCreateMany
  global dgBlueColor
  set many to 10
  tTest("DBCreate multiple files")
  repeat with DB = 1 to many
    put integer(DB) into field "iteration"
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
    set schema to "CHAR_FLD" & DB & ",C,25"
    put RETURN & "NUM_FLD" & DB & ",N,8,3" after schema
    put RETURN & "MEMO_FLD" & DB & ",M" after schema
    if the machineType <> 256 then
      set theDBFile to the moviePath & "Test Data:" & "TESTM" & DB
    else
      set theDBFile to the moviePath & "TESTDATA\" & "TESTM" & DB
    end if
    set DBResult to DBCreate(theDBFile, 3, schema, "false")
    if DBResult < 0 then
      tmsg("==== dbResult returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
    set DBResult to DBCloseAll()
    if DBResult < 0 then
      tmsg("==== DBCloseAll returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
    set videoID to DBUse(theDBFile)
    if videoID < 0 then
      tmsg("==== DBUse returned" && videoID & ".  (failed)")
      tFail()
      exit
    end if
    set theFields to DBListFields()
    set fieldCheck to "3" & RETURN & "CHAR_FLD" & DB & ",C,25,0"
    put RETURN & "NUM_FLD" & DB & ",N,8,3" after fieldCheck
    put RETURN & "MEMO_FLD" & DB & ",M,10,0" & RETURN after fieldCheck
    if theFields <> fieldCheck then
      tmsg("==== DBCreate's fields don't match .  (failed)")
      tFail()
      exit
    end if
  end repeat
  set DBResult to DBCloseAll()
  if DBResult < 0 then
    tmsg("==== DBCloseAll returned" && DBResult)
    tFail()
  else
    tPass()
  end if
end

on tDBWriteRecX
  global dgBlueColor
  set max to field "iterations"
  put EMPTY into field "iteration"
  tTest("DBWriteRec(X)")
  repeat with i = 1 to max
    put i into field "iteration"
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
    set NUM_FLD to string(integer(i))
    set CHAR_FLD to "Loop [" & integer(i) & "]"
    set theData to "NUM_FLD," & NUM_FLD & RETURN
    put "CHAR_FLD," & CHAR_FLD & RETURN after theData
    set theRec to DBCurrRecNum() + 1
    set DBResult to DBWriteRec("X", theRec, theData)
    if DBResult < 0 then
      tmsg("==== DBWriteRec(X) returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
  end repeat
  set numRecs to DBCount()
  if numRecs <> max then
    tmsg("==== DBWriteRec(X) had wrong total record count.  (failed)")
    tFail()
    exit
  end if
  repeat with i = max down to 1
    set theData to integer(i) & RETURN & "N"
    put RETURN & "CHAR_FLD,C,Loop [" & string(integer(i)) & "]" after theData
    put RETURN & "NUM_FLD,N," & string(integer(i)) after theData
    put RETURN & "MEMO_FLD,M" & RETURN after theData
    put integer(i) into field "iteration"
    set DBResult to DBGo(i)
    if DBResult < 0 then
      tmsg("==== DBGo returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
    set theNewData to DBGetCurrRecVal("X")
    if theNewData <> theData then
      tmsg("==== Data retrieval mismatch.  (failed)")
      put RETURN & "ORIGINAL DATA: [" & theData & "]" after field "mmsg"
      put RETURN & "ORIGINAL DATA: [" & theNewData & "]" after field "mmsg"
      tFail()
      exit
    end if
  end repeat
  tPass()
end

on tDBWriteRecManyX
  global dgBlueColor
  set max to field "iterations"
  set many to 10
  put EMPTY into field "iteration"
  tTest("DBWriteRec(X) multiple files")
  repeat with DB = 1 to many
    if the machineType <> 256 then
      set theDBFile to the moviePath & "Test Data:" & "TESTM" & DB
    else
      set theDBFile to the moviePath & "TESTDATA\" & "TESTM" & DB
    end if
    set theResult to DBUse(theDBFile)
    if theResult < 0 then
      tFail()
      exit
    end if
  end repeat
  repeat with DB = 1 to many
    set DBResult to DBSelect(DB)
    if DBResult < 0 then
      tFail()
      exit
    end if
    repeat with i = 1 to max
      put integer(DB) & "-" & integer(i) into field "iteration"
      set the textFont of member "iteration" to "Helvetica"
      set the textSize of member "iteration" to 9
      set the foreColor of member "iteration" to dgBlueColor
      set NUM_FLD to string(integer(i))
      set CHAR_FLD to "Loop [" & string(integer(DB)) & "-" & integer(i) & "]"
      set theData to "NUM_FLD" & string(integer(DB)) & "," & NUM_FLD & RETURN
      put "CHAR_FLD" & string(integer(DB)) & "," & CHAR_FLD & RETURN after theData
      set theRec to DBCurrRecNum() + 1
      set DBResult to DBWriteRec("X", theRec, theData)
      if DBResult < 0 then
        tmsg("==== DBWriteRec(X) returned" && DBResult & ".  (failed)")
        tFail()
        exit
      end if
    end repeat
    set numRecs to DBCount()
    if numRecs <> max then
      tmsg("==== DBWriteRec(X) had wrong total record count.  (failed)")
      tFail()
      exit
    end if
    repeat with i = max down to 1
      set theData to integer(i) & RETURN & "N"
      put RETURN & "CHAR_FLD" & string(integer(DB)) & ",C,Loop [" & string(integer(DB)) & "-" & string(integer(i)) & "]" after theData
      put RETURN & "NUM_FLD" & string(integer(DB)) & ",N," & string(integer(i)) after theData
      put RETURN & "MEMO_FLD" & string(integer(DB)) & ",M" & RETURN after theData
      put integer(DB) & "-" & integer(i) into field "iteration"
      set the textFont of member "iteration" to "Helvetica"
      set the textSize of member "iteration" to 9
      set the foreColor of member "iteration" to dgBlueColor
      set DBResult to DBGo(i)
      if DBResult < 0 then
        tmsg("==== DBGo returned" && DBResult & ".  (failed)")
        tFail()
        exit
      end if
      set theNewData to DBGetCurrRecVal("X")
      if theNewData <> theData then
        tmsg("==== Data retrieval mismatch.  (failed)")
        put RETURN & "ORIGINAL DATA: [" & theData & "]" after field "mmsg"
        put RETURN & "ORIGINAL DATA: [" & theNewData & "]" after field "mmsg"
        tFail()
        exit
      end if
    end repeat
  end repeat
  set DBResult to DBCloseAll()
  if DBResult < 0 then
    tFail()
    exit
  end if
  put EMPTY into field "iteration"
  tPass()
end

on tmsg theMsg
  put theMsg & RETURN after field "mmsg"
end

on twait howlong
  set now to the ticks
  repeat while 1 = 1
    if (the ticks - (howlong * 60)) > now then
      exit repeat
    end if
  end repeat
end

on tMemStart
  global oldBytes
  set oldBytes to the freeBytes
end

on tmemend
  global oldBytes, verboseTest
  if verboseTest then
    set newBytes to the freeBytes
    set theBytes to oldBytes - newBytes
    tmsg("==== Test consumed" && theBytes && "bytes.")
    tmsg("==== The largest contiguous remaining free block is" && the freeBlock && "bytes.")
  end if
end

on tTest theTest
  global tName, verboseTest, tNameLen
  set max to field "iterations"
  set tName to theTest
  if max > 1000 then
    put EMPTY into field "mmsg"
  end if
  tMemStart()
  if verboseTest then
    tmsg(EMPTY)
    tmsg("== Testing" && tName & "...")
  else
    put padIt("== Testing" && tName & "...", 50, ".") after field "mmsg"
  end if
  set the text of cast "testName" to "Testing" && tName & "..."
  set the text of cast "iteration" to EMPTY
end

on tPass
  global tName, verboseTest, tNameLen
  if verboseTest then
    tmemend()
    tmsg("==== Testing" && tName && "SUCCEEDED.")
  else
    tmsg("SUCCEEDED.")
  end if
end

on tFail
  global tName, verboseTest
  if verboseTest then
    tmemend()
    tmsg("==== Testing" && tName && "FAILED.")
    tmsg(EMPTY)
  else
    tmsg("FAILED.")
  end if
end

on tClear
  if the number of chars in field "mmsg" > 30000 then
    put EMPTY into field "mmsg"
  end if
end

on padIt s, theLen, c
  set newChars to theLen - the number of chars in s
  set pad to EMPTY
  repeat with i = 1 to newChars
    put c after pad
  end repeat
  set theString to s & pad
  return theString
end